home *** CD-ROM | disk | FTP | other *** search
- ' $title:'LZIP - Attempt to make the Littlest ZIP file' $pagesize:74 $linesize:132
- ' by S. David Klein, version 1.3, 3/11/89
- ' derived from LARC version 1.6 by Vernon D. Buerg, used with permission
- '
- ' Purpose:
- ' - make the smallest ZIP files possible
- ' - learn how the ADVBAS subroutines work
- ' - evaluate compression efficiency of ZIP options
- ' - convert all ARC files to the smallest ZIP files possible
- '
- ' Usage:
- ' LZIP13 d:[\path\]filespec [d:\outpath] [/R] [/F]
- '
- ' The input file specification is required and specifies the
- ' location of ZIP files to be processed. The path name is optional.
- '
- ' You MUST not have the input dir as the current dir. The current
- ' drive (and directory) is used for temporary work space. Each
- ' ZIP file is extracted to the current directory.
- '
- ' If the processed ZIP file is smaller, the original ZIP file
- ' is replaced. The file's date and time are preserved.
- '
- ' You must have ARCE, PKZIP and PKUNZIP accessible from the DOS path;
- ' PKZIP must be version 0.92 which supports the -ex option
- ' if you have changed the names of the .EXE files, make the necessary
- ' changes in this source and compile/link (QB 4.5):
- ' BC LZIP13 /D/E/O;
- ' LINK LZIP13,,,ADVBAS;
- '
- ' Options:
- ' /R specifies that a summary report is produced in the file LZIP.RPT.
- ' /F specifies that the first ZIP created will replace the original file;
- ' this is useful when adding a comment or replacing all ARC files.
- '
- ' ==========================================================================
- ' Definitions
-
- defint a-z : maxfiles = 512
-
- dim arc$(maxfiles) ' filenames and stats for later
- dim method$(3) ' up to three methods used
- dim savings(3) ' total bytes saved per method
-
- version$="LZIP Version 1.3" ' some internal signs
- author$="by S. David Klein"
-
- false = 0 : true = not false
- cluster = 512 ' target disk cluster size
-
- ' $dynamic
-
- dim before!(maxfiles) ' original file sizes
- dim after!(maxfiles,3) ' sizes after each method
- dim stamp(maxfiles,6) ' file mo,dy,yr;hr,min,sec
- ' $static
-
- def fneat$(x!) ' neaten number displays
- fneat$ = right$(space$(8)+str$(x!),8)
- end def
-
- def fn ltrim$(x$) ' trim leading blanks
- while left$(x$,1)=" "
- x$=mid$(x$,2)
- wend
- fn ltrim$ = x$
- end def
-
- def fn rtrim$(x$) ' trim trailing blanks
- while right$(x$,1)=" "
- x$=left$(x$,len(x$)-1)
- wend
- fn rtrim$ = x$
- end def
-
- def fn trim$(x$) ' trim left and right blanks
- fn trim$ = fn rtrim$(fn ltrim$(x$))
- end def
-
- def fn switch (x$) ' process option switches
- if instr(parm$,x$) _
- then fn switch = true : _
- mid$(parm$,instr(parm$,x$),2)=" " _
- else fn switch = false
- end def
-
- ' $page $subtitle: 'Initialization'
- ' =============================================================================
-
- initialize:
- on error goto err.traps
-
- call getdosv(majorv,minorv) ' check dos version
- if majorv<3 then print "Incorrect DOS version." : end
-
- parm$=command$ ' command parameters and options
- swr = fn switch ("/R") ' produce LZIP.RPT
- swf = fn switch ("/F") ' force ZIP replacement
-
- swa=true ' use the -aex option of PKZIP 0.92
-
- method=1 ' index to method name
- method$(method)="A"
-
- ' get input file d:\path\filename
- if instr(parm$," ") _ ' and output drive:\path
- then infile$ = fn trim$(left$(parm$,instr(parm$," ")-1)) : _
- outpath$ = fn trim$(mid$(parm$,instr(parm$," ")+1)) _
- else infile$ = fn trim$(parm$) : _
- outpath$ = ""
-
- if infile$="" then print "Input filespec missing!" : end
-
- if instr(infile$,".")=0 then infile$=infile$+".ZIP"
-
-
- in.drive$=" " ' get drive letter of original files
- if mid$(infile$,2,1) = ":" _
- then in.drive$=left$(infile$,1) : _
- infile$=mid$(infile$,3) _
- else print "You must supply the input drive letter!" : _
- end
-
- call drvspace (in.drive$,a,b,c) ' initial free space on source drive
- before.space! = csng(a)*csng(b)*csng(c)
- cluster = a * 512 ' target disk cluster size
-
- inpath$="" ' get input drive and path names
-
- for i=len(infile$) to 1 step -1 'altered this section 12/26/88
- if mid$(infile$,i,1)="\" then 'to work with QB 4.5, since the
- inpath$=left$(infile$,i) 'ELSE NEXT structure seemed not
- infile$=mid$(infile$,i+1) 'to work. This seems to do the
- end if 'job.
- next
-
- temp.drive$=" " ' make sure different drives\paths
- call getdrv(temp.drive$) ' for temp, input, and output
-
- temp.path$=string$(64,0) ' temporary d:\path
- call getsub (temp.path$,tlen)
- temp.path$="\"+left$(temp.path$,tlen)+"\"
- temp.file$=temp.drive$+":"+left$(temp.path$,len(temp.path$)-1)
-
- call findfirstf ("*.*"+chr$(0),0,retcd) ' insure temp is empty
-
- if (temp.drive$ = in.drive$ and temp.path$=inpath$) _
- or outpath$ = temp.file$ _
- or retcd = 0 _
- then
- print "Input path: ";in.drive$+":"+inpath$
- print "Output path: ";outpath$
- print "Temp path: ";temp.file$
- print
- print "You must use a different d:\path for the original input files,"
- print "and the output destination drive and path; other than the"
- print "current directory used for the temporary work files!"
- print "The temporary directory must be empty."
- end
- end if
-
- ' $page $subtitle: 'Mainline'
- ' =============================================================================
-
- mainline:
- attr = 0 : retcd=0 ' get first file name
- arcname$=in.drive$+":"+inpath$+infile$ ' from original filespec
-
- call findfirstf (arcname$+chr$(0),attr,retcd)
- if retcd then
- print "No matching files found for ";arcname$
- end
- end if
-
- ' Build table of files to process
-
- get.file: ' extract next file name
- infile$=space$(12)
- call getnamef (infile$,flen)
- if flen <0 _
- then print "GETNAMEF logical error." : end _
- else infile$=left$(infile$,flen)
-
- if numfiles < maxfiles _ ' save data for report
- then numfiles=numfiles+1
-
- call getdatef(month,day,year) ' preserve datestamp
- stamp(numfiles,1)=month
- stamp(numfiles,2)=day
- stamp(numfiles,3)=year
- call gettimef(hour,minute,second)
- stamp(numfiles,4)=hour
- stamp(numfiles,5)=minute
- stamp(numfiles,6)=second
-
- call getsizef(lo,hi) ' original file size
- lo!=csng(lo)
- if lo<0 then lo!=lo!+65536!
- insize!=lo!+csng(hi)*65536!
-
- arc$(numfiles)=infile$
- before!(numfiles)=insize!
- for method=1 to 3
- after!(numfiles,method)=insize!
- next method
-
- call findnextf (retcd) ' next file to process
- if retcd=0 then goto get.file
-
- ' $page $subtitle:'Invoke ARC processors for each archive file'
- ' ----------------------------------------------------------------
-
- process:
- 100 for filenum=1 to numfiles
- infile$=arc$(filenum) ' original file name
- insize!=before!(filenum) ' and file size
- before!=insize!
- arcname$=in.drive$+":"+inpath$+infile$ ' complete original filespec
-
- outfile$=infile$ ' form target file name
- if instr(infile$,".ARC") _
- then mid$(outfile$,instr(infile$,".ARC"),4)=".ZIP"
-
-
- 120 method = 0 ' index for method used to ZIP
-
- 'if insize!<cluster then ' skip small files?
- ' for s=1 to 3 ' commented out to force all
- ' after!(filenum,s)=insize! ' files to be processed
- ' next
- ' if outpath$ = "" _ ' unless copying all ZIP files
- ' then goto next.file
- 'end if
-
- replaced=copies ' times file has been copied
-
- if instr(arcname$,".ARC") _ ' extract the file
- then cmd$="arce "+arcname$ _
- else cmd$="pkunzip "+arcname$
-
- cls : color 15,0 : print cmd$ : color 7,0
- shell cmd$
-
-
- if swa then
- cmd$="pkzip -aex "+outfile$+" *.*" ' make the smallest ZIP
-
- ' some variations on the theme-
- ' to add a comment, use this example
- 'cmd$="pkzip -azex "+outfile$+" *.* < comment.txt where comment.txt
- ' contains the comment to be added
-
- cls : color 15,0 : print cmd$ : color 7,0
- shell cmd$
- gosub evaluate
- end if
-
- if okay then kill "*.*" ' rid extracted files
-
- if outpath$<>"" and replaced=copies then ' did not copy it yet?
- cmd$ = "copy "+arcname$+" "+outpath$ ' do it now
- cls : color 15,0 : print cmd$ : color 7,0
- shell cmd$
- copies = copies + 1
- end if
-
- if instr(arcname$,".ARC") and replaced<>copies and outpath$="" _
- then kill arcname$ ' delete original ARC file
-
- next.file:
- next filenum
-
- ' $page $subtitle: 'Display file statistics'
- ' =============================================================================
-
- report:
- 200 if swr _
- then rptname$="lzip.rpt" _
- else rptname$="scrn:"
- open rptname$ for output as #1
-
- beep ' wake em up
-
- if okay =0 _ ' something broke
- then locate 24,1 : _
- print "Aborted due to Error or ESC keyin!" : _
- print : _
- gosub newpage _
- else gosub heading
-
- for i=1 to numfiles
- if swr=0 and csrlin>22 then gosub newpage
- print #1,arc$(i);tab(15); fneat$(before!(i));
- for s=1 to method
- after=int( (after!(i,s)+cluster-1)/cluster)
- before=int( (before!(i)+cluster-1)/cluster)
- savings = after-before
- savings(s)=savings(s)+savings
- print #1,fneat$(after!(i,s)); fneat$(csng(savings)*cluster);
- next s
- print #1,
- next
-
- if swr=0 and csrlin>12 then gosub newpage
- print #1,copies;"file(s) replaced"; ' Sum of savings by method
- print #1,tab(30);" ";
- for s=1 to method
- print #1,fneat$(csng(savings(s))*cluster);" ";
- next
- print #1,
-
- call drvspace (in.drive$,a,b,c) ' get disk space saving
- after.space! = csng(a)*csng(b)*csng(c)
-
- print #1,
- print #1," Free disk space: "
- print #1," before ";
- print #1,using "##,###,###";before.space!
- print #1," after ";
- print #1,using "##,###,###";after.space!
- print #1," saved ";after.space! - before.space!;"bytes"
-
- close #1 ' all done
-
-
- if swr then
- open rptname$ for input as #1 ' display the report
- while not eof (1) ' in addition to writing it to
- line input #1,a$ ' the file to LZIP.RPT
- print a$
- wend
- close #1
- end if
-
- end
-
- newpage:
- line input "Press ENTER to continue:";a$
- heading:
- cls ' pretty fancy, eh?
- print #1,version$;" - Processing ";command$
- print #1,
- print #1,"Filename";tab(15);" before";
- for s=1 to method
- print #1," after";method$(s);" diff";
- next
- print #1,
- locate ,1
- return
-
- ' $page $subtitle: 'Evaluate results of re-ZIPing the files'
- ' ---------------------------------------------------------
-
- evaluate:
- okay = 0 ' indicates success or not
- if inkey$ = chr$(27) then return report ' aborted by ESCape key
- okay = 1
- method = method + 1
-
- 300 open outfile$ for input as #2 ' get new file size
- outsize!=lof(2)
- close #2
-
- 310 after!(filenum,method)=outsize!
-
- 'after=int( (outsize!+cluster-1)/cluster) ' compute clusters saved
- 'before=int( (before!+cluster-1)/cluster)
- savings! = outsize! - before! ' bytes (was clusters) saved
- 400 if savings! <0 or (outpath$<>"" and method=1) or swf then
-
- call setftd(outfile$+chr$(0),stamp(filenum,1),stamp(filenum,2), _
- stamp(filenum,3),stamp(filenum,4),stamp(filenum,5), _
- stamp(filenum,6) ) ' preserve date stamp
-
- if outpath$="" _ ' overlay original or to another subdir
- then cmd$= "copy "+outfile$+" "+in.drive$+":"+inpath$+outfile$ _
- else cmd$= "copy "+outfile$+" "+outpath$
-
- cls : color 15,0 : print cmd$ : color 7,0
- shell cmd$
- before!=outsize! ' new original file size
- copies=copies+1
-
- end if
-
- 410 kill outfile$ ' rid the temporary file
- copy.done:
- return
-
- copy.failed:
- okay = 0
- return report 'next.file ' file not found, not created, etc.
-
- err.traps:
- if erl=100 then print arcname$;" not found"
- if erl=410 then resume copy.done ' short file only copied
- if erl=300 then resume copy.failed ' no ZIP created
- print "Error";err;"at line";erl
- end